(in-package :parameterscout)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *standard-resistor-values* #(10d0 15d0 22d0 33d0 47d0 68d0
					     10d1 15d1 22d1 33d1 47d1 68d1
					     10d2 15d2 22d2 33d2 47d2 68d2
					     10d3 15d3 22d3 33d3 47d3 68d3
					     10d4 15d4 22d4 33d4 47d4 68d4
					     10d5 0d0)
    "A table of standard resistor values found in my EE 201 lab kit"))

(defparameter *standard-capacitor-values*
  #(100d-12 500d-12 0.001d-6 0.0047d-6 0.01d-6 0.047d-6 0.1d-6 1d-6 10d-6 100d-6 0d0)
  "A table of standard capacitor values found in my EE 201 lab kit")

(defparameter *standard-gear-teeth-values*
  #.(coerce (loop for x from 10 to 100 collect (coerce x 'double-float)) 'vector)
  "A table of all the teeth a gear can hold between 10 and
  100. If you want more or fewer teeth than this, you want more
  than a quick calculation.")

;; Composite resistor and capacitor values
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (macrolet ((collect-safely (expr)
	       `(handler-case (collect ,expr)
		  (division-by-zero (e) (declare (ignore e)))
		  (floating-point-invalid-operation (e) (declare (ignore e))))))
    (defun all-two-resistor-combinations ()
      "Return a vector of all two-resistor combinations"
      (coerce (remove-duplicates 
	       (collecting
		 (loop for r1 across *standard-resistor-values* do
		      (loop for r2 across *standard-resistor-values*
			 do (collect-safely (+ r1 r2))
			 do (collect-safely (/ (* r1 r2) (+ r1 r2)))))))
	      'vector))

    (defun all-three-resistor-combinations ()
      "Return a vector of all three-resistor combinations"
      (coerce (remove-duplicates 
	       (collecting
		 (loop for r1 across *standard-resistor-values* do
		      (loop for r2 across *standard-resistor-values* do
			   (loop for r3 across *standard-resistor-values*
			      do (collect-safely (+ r1 (/ (* r2 r3) (+ r2 r3))))
			      do (collect-safely (/ (* r1 (+ r2 r3)) (+ r1 (+ r2 r3))))
			      do (collect-safely (/ 1d0 (+ (/ 1d0 r1) (/ 1d0 r2) (/ 1d0 r3))))
			      do (collect-safely (+ r1 r2 r3)))))))
	      'vector))))

(defparameter *standard-2-resistor-values* #.(all-two-resistor-combinations)
  "An array of all resistor values which can be made by combining
  two resistors")

(defparameter *standard-3-resistor-values* #.(all-three-resistor-combinations)
  "An array of all resistor values which can be made by combining
  three resistors")

;; Suggested values
;;;;;;;;;;;;;;;;;;;

(defun suggested-values-exist-p (free-variable-symbol)
  "If there are suggested values for free-variable-symbol, then
  return return the type of elements used, a symbol which will be
  either RESISTOR, CAPACITOR, GEAR, or nil. Also return the
  maximum NUMBER-OF-ELEMENTS that RETURN-SUGGESTED-VALUES will
  accept."
  (let ((sname (symbol-name free-variable-symbol)))
    (case (elt sname 0)
      ((#\R #\r) (values 'resistor 3))
      ((#\C #\c) (values 'capacitor 1))
      ((#\G #\g) (values 'gear 1))
      (t nil))))

(defun return-suggested-values (free-variable-symbol &optional (number-of-elements 1))
  "Given a symbol like R3 or X, return an array of suggested
values to iterate through. Or return nil if no values are
suggested. The NUMBER-OF-ELEMENTS parameter controls how many
resistors or capacitors are to be involved in the construction of
the suggested value, with 1 being the default. If the specified
value is too high, it will be rounded down to the largest number
for which precalculated values exist, usually 2 or 3."
  (labels ((elt-with-saturation (n list)
	     "Like elt, but with argument order swapped and any
              out-of-bounds references are simply rounded to the
              nearest in-bounds index."
	     (if (< n 0) (setf n 0))
	     (if (>= n (length list)) (setf n (1- (length list))))
	     (elt list n)))
    (let ((element-type (suggested-values-exist-p free-variable-symbol)))
      (ecase element-type
	(resistor  (elt-with-saturation (1- number-of-elements) (list *standard-resistor-values* 
								      *standard-2-resistor-values*
								      *standard-3-resistor-values*)))
	(capacitor *standard-capacitor-values*)
	(gear      *standard-gear-teeth-values*)
	(nil       nil)))))